unit WbNodeFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, StrUtils,
  WbExecutive_TLB, ActiveX, ComObj, ComServ, Math, advApiHook, DateUtils, Res,
  ShlObj;

type
  TWbNodeForm = class(TForm)
    wb: TEmbeddedWB;
    procedure WbInit();
    procedure WbUpdate();
    procedure FormCreate(Sender: TObject);
    procedure wbTitleChange(ASender: TObject; const Text: WideString);
    procedure wbNewWindow2(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
  private
    { Private declarations }
  public
    { Public declarations }
    WbNodeSN: Integer;
    WbNode_UpdatedString:String;
    WbTitle:String;
    IsInitialized:boolean;
    function ProcessReceivedData(s: String): Integer;
    procedure WMCopyData(var Msg: TWMCopyData);message WM_COPYDATA;//oops, forgot the "message" part.
    procedure WmForWb(var msg:tmessage); message WM_PAINT;
    function SendData(h: HWND; const copyDataStruct: TCopyDataStruct): Integer;
    function SendString(h: HWND; s: String): Integer;
    function RemoteCall(Cmd: String; SN: Integer; Param: String): Integer;
    function Encode(s:String):String;
    function Decode(s:String):String;
    procedure InformAboutNewWindow2();
  end;

var
  WbCenterHWND: HWND;
  WbNodeParentHWND: HWND;
  WbNodeForm:TWbNodeForm;
  ExecWb_a,ExecWb_b:Integer;
  //the following is hook stuff:
  TrueCreateProcessW: function(
   lpApplicationName: LPCWSTR;
   lpCommandLine:LPCWSTR;//CHANGED. original: var lpCommandLine: LPWSTR;
   lpProcessAttributes, lpThreadAttributes: Pointer;//CHANGED
   bInheritHandles: BOOL;
   dwCreationFlags: DWORD;
   lpEnvironment: Pointer;//CHANGED
   lpCurrentDirectory: LPCWSTR;
   const lpStartupInfo: STARTUPINFOW;
   var lpProcessInformation: PROCESS_INFORMATION
   ): BOOL; stdcall;
  TrueCreateProcessA: function(
   lpApplicationName: PAnsiChar;
   lpCommandLine: PAnsiChar;//CHANGED. original: var lpCommandLine: PAnsiChar;
   lpProcessAttributes, lpThreadAttributes: Pointer;//CHANGED
   bInheritHandles: BOOL;
   dwCreationFlags: DWORD;
   lpEnvironment: Pointer;//CHANGED
   lpCurrentDirectory: PAnsiChar;
   const lpStartupInfo: STARTUPINFOW;
   var lpProcessInformation: PROCESS_INFORMATION
   ): BOOL; stdcall;
   MouseHookID: THandle;
   MouseButtonUpDateTime:TDateTime;
   res:TRes;
   WbStartDateTime:TDateTime;
   DefaultBrowser:String;

const
  SeperateGuid = '{e5450621-9d35-4eee-b584-0e9072130860}';
  HyphenGuid = '{440e616b-9be5-4f1c-962a-1232fcae76fe}';
  NewLineGuid = '{4d4b9ad1-bb21-47d6-8323-8cbd95b81ee5}';

implementation

{$R *.dfm}

procedure DisplayMessage(Text: String; title: String);
begin
  MessageBox(0, PChar(Text), PChar(title), MB_ICONEXCLAMATION);
end;

function WmCopyData_SendData(h: HWND; const copyDataStruct: TCopyDataStruct)
  : Integer;
var
  receiverHandle: THandle;
  res: Integer;
begin
  receiverHandle := h;
  if receiverHandle = 0 then
  begin
    //ShowMessage('CopyData Receiver NOT found!');
    Exit;
  end;
  Result := SendMessage(receiverHandle, WM_COPYDATA, Integer(h),//Handle
    Integer(@copyDataStruct));
end;
function WmCopyData_SendString(h: HWND; s: String): Integer;
var
  stringToSend: string;
  copyDataStruct: TCopyDataStruct;
begin
  stringToSend := s;
  copyDataStruct.dwData := 0; // use it to identify the message contents
  copyDataStruct.cbData := (1 + Length(stringToSend)) * 2; // modified
  copyDataStruct.lpData := PChar(stringToSend);
  Result := WmCopyData_SendData(h, copyDataStruct);
end;
function WbNode_Thread(Parameter : Pointer) : Integer;
var
h:HWND;
begin
h := WbNodeForm.Handle;
SendMessage(h,WM_PAINT,1000,1000);
while True do
begin
  SendMessage(h,WM_PAINT,1001,1001);
  Sleep(100);
end;
EndThread(0);
end;

//==============================================================================
//New Proc
//==============================================================================
function GetSpecialFolder( folderID: integer ): string;
var
pidl: PItemIDList;
buf : array[0..MAX_PATH] of char;
begin
result := '';
if Succeeded( ShGetSpecialFolderLocation(GetActiveWindow, folderID, pidl) ) then begin
if ShGetPathfromIDList( pidl, buf ) then
result := buf;
CoTaskMemFree(pidl);
end;
if (result <> '') and (result[Length(result)] <> '\') then
result := result +'\';
end;
const
CSIDL_PROGRAM_FILES = $0026; // C:\Program Files\
function GetProgramFilesDir(): string;
begin
Result := GetSpecialFolder(CSIDL_PROGRAM_FILES);//it ends with slash
end;
function SBfolder():String;
begin
Result := GetProgramFilesDir+'Sandboxie';
end;

function LongToShortFilePath(const LongName: string): string;
//http://www.delphidabbler.com/codesnip?action=named&showsrc=1&routines=LongToShortFilePath
begin
  SetLength(Result, Windows.MAX_PATH);
  SetLength(
    Result,
    Windows.GetShortPathName(
      PChar(LongName), PChar(Result), Windows.MAX_PATH
    )
  );
end;
{//http://stackoverflow.com/questions/3527221/how-do-i-properly-call-getlongpathname-using-delphi-2009-and-unicode-strings
function GetLongPathName(ShortPathName: PChar; LongPathName: PChar;
    cchBuffer: Integer): Integer; stdcall; external kernel32 name 'GetLongPathNameW';
function ExtractLongPathName(const ShortName: string): string;
begin
  SetLength(Result, GetLongPathName(PChar(ShortName), nil, 0));
  SetLength(Result, GetLongPathName(PChar(ShortName), PChar(Result), length(Result)));
end;}
function ShortToLongFilePath(const FilePath: string): string;
//http://www.delphidabbler.com/codesnip?action=named&showsrc=1&routines=ShortToLongFilePath
var
  PrevPath: string;         // path before last file/dir in FilePath
  ExpandedName: string;     // long form of file name
  SR: SysUtils.TSearchRec;  // record used by file find functions
  Success: Integer;         // indicates success in finding a file
  // ---------------------------------------------------------------------------
  function CountPathDelims(const Name: string): Integer;
    {Counts path separators in given name}
  var
    Idx: Integer; // loops thru name string
  begin
    Result := 0;
    for Idx := 1 to Length(Name) do
      if SysUtils.IsPathDelimiter(Name, Idx) then
        Inc(Result);
  end;

  function IsServerName(const Name: string): Boolean;
    {Returns true if Names is in form \\Server\Share}
  begin
    Result := (SysUtils.AnsiPos('\\', Name) = 1)
      and (CountPathDelims(Name) = 3);
  end;
  // ---------------------------------------------------------------------------
begin
  // Check if we have a drive, server/share or root path, and exit if so
  // (we can't apply file search to any of these, so we return them unchanged
  if (FilePath = '')
    or (FilePath = '\')
    or ((Length(FilePath) = 2) and (FilePath[2] = ':'))
    or ((Length(FilePath) = 3) and (FilePath[2] = ':') and (FilePath[3] = '\'))
    or IsServerName(FilePath) then
  begin
    Result := FilePath;
    Exit;
  end;
  // Do a file search on file: this is used to expand name
  Success := SysUtils.FindFirst(FilePath, SysUtils.faAnyFile, SR);
  try
    if Success = 0 then
      ExpandedName := SR.FindData.cFileName
    else
      ExpandedName := '';
  finally
    SysUtils.FindClose(SR);
  end;
  // Check if there's any part of path we've not handled, and convert it if so
  PrevPath := SysUtils.ExtractFileDir(FilePath);
  if PrevPath <> '' then
  begin
    // We have unprocessed part of path: expand that
    Result := ShortToLongFilePath(PrevPath);
    // Appended currently expanded name to path
    if (Result <> '') and (Result[Length(Result)] <> '\') then
      Result := Result + '\';
    Result := Result + ExpandedName;
  end
  else
    // No earlier parts of path: just record expanded name
    Result := ExpandedName;
end;
Function GetUserFromWindows: string;
//http://delphi.about.com/cs/adptips2002/a/bltip0102_3.htm
 Var
    UserName : string;
    UserNameLen : Dword;
 Begin
    UserNameLen := 255;
    SetLength(userName, UserNameLen) ;
    If GetUserName(PChar(UserName), UserNameLen) Then
      Result := Copy(UserName,1,UserNameLen - 1)
    Else
      Result := 'Unknown';
 End;

function TempFolderShort():String;
begin
//ends with "\"
Result := LongToShortFilePath(res.TempFolder);
end;
function TempFolderLong():String;
begin
//ends with "\"
Result := ShortToLongFilePath(res.TempFolder);
end;
function SandboxTempFolderShort():String;
var
IndexAfterUser:Integer;
begin
//Returns something like this:
//D:\Sandbox\user\Sandbo~1\user\current\AppData\Local\Temp\
Result := Copy(SBfolder,1,3);
Result := Result + 'Sandbox\';
Result := Result + GetUserFromWindows;
Result := Result + '\SandboxDedicatedForBrowser\user\current\';
IndexAfterUser := PosEx(
                    UpperCase('\'+GetUserFromWindows+'\'),
                    UpperCase(TempFolderLong),
                    4
                    )
                  +Length('\'+GetUserFromWindows+'\');
Result := Result + Copy(TempFolderLong,IndexAfterUser,Length(TempFolderLong)-IndexAfterUser+1);
Result := LongToShortFilePath(Result);
end;
procedure NewProc(Name,ApplicationName,CommandLine,CurrentDirectory:String);
var
Cmd:String;
CmdUpperCase:String;
//DefaultBrowser:String;//oops, forgot to remove this - it's global variable now.
UrlInCmd:String;
StartInfo  : TStartupInfo;
ProcInfo   : TProcessInformation;
sl:TStringList;
begin
if CommandLine <> '' then
  Cmd := CommandLine
else
  Cmd := ApplicationName;
CmdUpperCase := UpperCase(Cmd);

//sometimes the default browser is executed.
//this catches it.
{DefaultBrowser := DefaultBrowserInformation.Path + '\' + DefaultBrowserInformation.Name;}
//DisplayMessage('DefaultBrowser="'+DefaultBrowser+'"','');
if (Pos(UpperCase(DefaultBrowser),CmdUpperCase)>0)
  or (Pos('\IEXPLORE.EXE',CmdUpperCase)>0)//sometimes IE is started. stop it.
  then
begin
  //do nothing
  exit;
end;

//special programs that are designed to run inside sandbox:
//run it without further handling.
//1. run it inside sandbox, if right after browser started. Some IME needs this.
//2. run it inside sandbox, if it's Sandboxie stuff.
//DisplayMessage('SBfolder="'+SBfolder+'"','');
if (MilliSecondsBetween(WbStartDateTime,now)<=3000)//5000
   or (Pos(UpperCase(SBfolder),CmdUpperCase)<>0)
   then
begin
  FillChar(StartInfo,SizeOf(TStartupInfo),#0);
  FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
  StartInfo.cb := SizeOf(TStartupInfo);
  TrueCreateProcessW(PWideChar(ApplicationName),
                      PWideChar(CommandLine)
                      ,nil,nil,false,CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,nil,
                      PWideChar(CurrentDirectory),
                      StartInfo, ProcInfo);
  exit;
end;

//if the external program wants temp folder content
//switch it to temp folder inside sandbox
{if IsDebug then
DisplayMessage('TempFolderShort="'+TempFolderShort+'"'+sLineBreak+
                'TempFolderLong="'+TempFolderLong+'"'+sLineBreak+
                'SandboxTempFolderShort="'+SandboxTempFolderShort+'"'
                ,'');}
Cmd := StringReplace(Cmd, TempFolderShort, SandboxTempFolderShort,[rfReplaceAll, rfIgnoreCase]);
Cmd := StringReplace(Cmd, TempFolderLong, SandboxTempFolderShort,[rfReplaceAll, rfIgnoreCase]);

//DisplayMessage('Name="'+Name+'"'+sLineBreak+
//               'ApplicationName="'+ApplicationName+'"'+sLineBreak+
//               'CommandLine="'+CommandLine+'"'+sLineBreak+
//               'CurrentDirectory="'+CurrentDirectory+'"','');
sl := TStringList.Create;
sl.Text := Cmd;
if FileExists(res.NewProcTxt) then DeleteFile(res.NewProcTxt);
sl.SaveToFile(res.NewProcTxt,TEncoding.UTF8);
sl.Free;
end;
function NewCreateProcessW(
  lpApplicationName: LPCWSTR;
  lpCommandLine: LPCWSTR;//Changed to the same as lpApplicationName;
                         //This does not work: "var lpCommandLine: LPWSTR;"
   lpProcessAttributes, lpThreadAttributes: Pointer;//CHANGED
   bInheritHandles: BOOL;
   dwCreationFlags: DWORD;
   lpEnvironment: Pointer;//CHANGED
   lpCurrentDirectory: LPCWSTR;
   const lpStartupInfo: STARTUPINFOW;
   var lpProcessInformation: PROCESS_INFORMATION
): BOOL; stdcall;
begin
  NewProc('CreateProcessW',lpApplicationName,lpCommandLine,lpCurrentDirectory);
  //TrueMessageBoxA ... disabled.
  Result := true;
end;
function NewCreateProcessA(
  lpApplicationName: PAnsiChar;
  lpCommandLine:PAnsiChar; //CHANGED. original: var lpCommandLine: PAnsiChar;
   lpProcessAttributes, lpThreadAttributes: Pointer;//CHANGED
   bInheritHandles: BOOL;
   dwCreationFlags: DWORD;
   lpEnvironment: Pointer;//CHANGED
   lpCurrentDirectory: PAnsiChar;
   const lpStartupInfo: STARTUPINFOW;
   var lpProcessInformation: PROCESS_INFORMATION
): BOOL; stdcall;
begin
  NewProc('CreateProcessA',lpApplicationName,lpCommandLine,lpCurrentDirectory);
  //TrueMessageBoxA ... disabled.
  Result := true;
end;
procedure HookNewProcApi();
begin
//
//weird - run this from delphi - no hook; run this directly(explorer/cmd) - hooked.
//
HookProc('kernel32.dll', 'CreateProcessW', @NewCreateProcessW, @TrueCreateProcessW);
HookProc('kernel32.dll', 'CreateProcessA', @NewCreateProcessA, @TrueCreateProcessA);
end;

//==============================================================================
//Hook Mouse
//==============================================================================
function IsAfterMouseButtonUp():boolean;
begin
  //popup blocking - use MouseButtonUpDateTime
  if MilliSecondsBetween(MouseButtonUpDateTime,now)>500 then//300 //200 //150
    Result := false
  else
    Result := true;
  //SecondsBetween(Now, IncSecond(Now,10))
  //Will return 10
  //http://stackoverflow.com/questions/9790204/difference-in-seconds-between-two-tdatetime-variables
end;
//Mouse hook is mainly from:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=2004
function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
if (wParam=WM_LBUTTONUP) or (wParam=WM_RBUTTONUP) then
//use ButtonUp message, not ButtonDown. More Precise.
begin
  //Form1.Caption := 'WM_LBUTTONUP';
  MouseButtonUpDateTime := now;
end;
Result := CallNextHookEx(MouseHookID, nCode, wParam, lParam);
end;
procedure HookMouse();
begin
MouseHookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
end;

//==============================================================================
//Form OnCreate
//==============================================================================
procedure TWbNodeForm.FormCreate(Sender: TObject);
var
id1: LongWord;
thread1: Integer;
begin
    //http://blog.delphi-jedi.net/2008/07/01/com-server-tells-you-sth-about-opened-client-connections/
    ComServer.UIInteractive := false;

    // PROBLEM: Go to some website, click to login, crash.
    // FIX: IT WORKS!!! from http://stackoverflow.com/questions/8200581/twebbrowser-crashes-with-embedded-youtube-clips
    Math.SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow,
      exUnderflow, exPrecision]);

    res := TRes.Create;
    WbStartDateTime := now;

    HookMouse;
    HookNewProcApi;

    WbNode_UpdatedString := '';
    WbTitle := '';
    WbNodeParentHWND := 0;
    WbNodeSN := 0;

    {WbInit();}
    thread1 := BeginThread(nil,0,Addr(WbNode_Thread),nil,0,id1);
end;

function ExecWb_Thread(Parameter : Pointer) : Integer;
begin
WbNodeForm.SendString(WbNodeForm.Handle,'ExecWB-DoIt');
EndThread(0);
end;

function TWbNodeForm.ProcessReceivedData(s: String): Integer;
var
  sl,sl2: TStringList;
  i,index: Integer;
  a,b:Integer;
  TempString:String;
  id1: LongWord;
  thread1: Integer;
begin
  sl := TStringList.Create;
  sl.Text := s;

  if sl.Strings[0] = 'Hide' then
  begin
    //ShowMessage('TWbNodeForm.ProcessReceivedData - Hide');
    //wb.Visible := false;
    ShowWindow(wb.Handle,SW_HIDE);
  end
  else if sl.Strings[0] = 'Show' then
  begin
    //ShowMessage('TWbNodeForm.ProcessReceivedData - Show');
    //wb.Visible := true;
    ShowWindow(wb.Handle,SW_SHOW);
  end
  else if sl.Strings[0] = 'Navigate' then
  begin
    TempString := Decode(sl.Strings[2]);
    wb.Navigate(TempString);
  end
  else if sl.Strings[0] = 'GoHome' then
  begin
    wb.GoHome;
  end
  else if sl.Strings[0] = 'Destroy' then
  begin
    Destroy;
  end
  else if sl.Strings[0] = 'WbParent' then
  begin
    WbNodeParentHWND := StrToInt(sl.Strings[2]);
  end
  else if sl.Strings[0] = 'DefaultBrowser' then
  begin
    DefaultBrowser := sl.Strings[2];
    //DisplayMessage('DefaultBrowser="'+DefaultBrowser+'"','');
  end
  else if sl.Strings[0] = 'SetSilent' then
  begin
    if sl.Strings[2] = 'true' then wb.Silent := true;
    if sl.Strings[2] = 'false' then wb.Silent := false;
  end
  else if sl.Strings[0] = 'GoBack' then
  begin
    try
      wb.GoBack;
    except
      ;
    end;
  end
  else if sl.Strings[0] = 'GoForward' then
  begin
    try
      wb.GoForward;
    except
      ;
    end;
  end
  else if sl.Strings[0] = 'Refresh' then
  begin
    try
      wb.Refresh;
    except
      ;
    end;
  end
  else if sl.Strings[0] = 'Stop' then
  begin
    try
      wb.Stop;
    except
      ;
    end;
  end
  else if sl.Strings[0] = 'ExecWB' then
  begin
    sl2 := TStringList.Create;
    TempString := sl.Strings[2];
    TempString := StringReplace(TempString, SeperateGuid, sLineBreak,[rfReplaceAll, rfIgnoreCase]);
    sl2.Text := TempString;
    ExecWb_a:=StrToInt(sl2.Strings[0]);
    ExecWb_b:=StrToInt(sl2.Strings[1]);
    sl2.Free;
    thread1 := BeginThread(nil,0,Addr(ExecWb_Thread),nil,0,id1);
  end
  else if sl.Strings[0] = 'ExecWB-DoIt' then
  begin
    try
      wb.ExecWB(ExecWb_a,ExecWb_b);
    except
      ;
    end;
  end
  else if sl.Strings[0] = 'ExecScript' then
  begin
    try
      wb.GetDocument.parentWindow.execScript(Decode(sl.Strings[2]),'JScript');
    except
      ;
    end;
  end
  else if sl.Strings[0] = 'Repaint' then
  begin
    try
      wb.Repaint;
    except
      ;
    end;
  end;

  sl.Free;
end;

procedure TWbNodeForm.WMCopyData(var Msg: TWMCopyData);
var
  s: string;
begin
  s := PChar(Msg.copyDataStruct.lpData);
  //ShowMessage('s="' + s + '"');
  Msg.Result := ProcessReceivedData(s);
  // Send something back
  // msg.Result := 2006;
end;
procedure TWbNodeForm.WmForWb(var msg:tmessage);
begin
  if (Msg.LParam=1000) and (Msg.WParam=1000) then
  begin
    WbInit();
    exit;
  end;
  if (Msg.LParam=1001) and (Msg.WParam=1001) then
  begin
    WbUpdate();
    exit;
  end;

end;


function TWbNodeForm.SendData(h: HWND; const copyDataStruct: TCopyDataStruct)
  : Integer;
var
  receiverHandle: THandle;
  res: Integer;
begin
  receiverHandle := h;
  if receiverHandle = 0 then
  begin
    //ShowMessage('CopyData Receiver NOT found!');
    Exit;
  end;
  Result := SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle),
    Integer(@copyDataStruct));
end;

function TWbNodeForm.SendString(h: HWND; s: String): Integer;
var
  stringToSend: string;
  copyDataStruct: TCopyDataStruct;
begin
  stringToSend := s;
  copyDataStruct.dwData := 0; // use it to identify the message contents
  copyDataStruct.cbData := (1 + Length(stringToSend)) * 2; // modified
  copyDataStruct.lpData := PChar(stringToSend);
  Result := SendData(h, copyDataStruct);
end;

procedure TWbNodeForm.WbInit();
var
  cr, wr: TRect;
  wc: TWinControl;
  r:Integer;
begin
  //Timer1.Enabled := false;

  WbCenterHWND := FindWindow('TWbCenterForm',nil);
  if WbCenterHWND=0 then
  begin
    DisplayMessage('WbCenterForm is not found','');
    ExitProcess(0);
  end;

  wb.Width := 0;
  wb.Height := 0;

  r:=RemoteCall('WbNodeInit', 0,
                  IntToStr(Handle)+SeperateGuid+
                  IntToStr(wb.Handle)+SeperateGuid+
                  IntToStr(GetCurrentProcessId)
                  );
  WbNodeSN := r;
  while WbNodeParentHWND = 0 do
  begin
    Sleep(1);
    Application.ProcessMessages;
  end;
  //DisplayMessage('WbNodeParentHWND='+IntToStr(WbNodeParentHWND),'');
    //DisplayMessage('WbNodeSN of NodeHasNewWb is '+IntToStr(WbNodeSN),'');

  //Timer2.Enabled := true;


  // ShowMessage('WbNodeParentHWND='+IntToStr(WbNodeParentHWND));
  Windows.SetParent(Wb.Handle, WbNodeParentHWND);

  //
  //Important: the following code steals focus.
  //And it's useless - so it's disabled.
  {

  //Wb.Show;
  //Wb.Navigate('http://www.google.com');

  Windows.SetParent(Handle, WbNodeParentHWND);
  Windows.SetParent(Application.Handle, WbNodeParentHWND);

  // ShowMessage('TWbNodeForm.FormCreate - 1');
  // ShowMessage('TWbNodeForm.FormCreate - end');
  }
end;

procedure TWbNodeForm.wbNewWindow2(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
var
IExec:IWbExecutiveClass;
begin
if not IsAfterMouseButtonUp then
begin
  Cancel := true;
  exit;
end;
IExec := GetActiveOleObject('WbExecutive.WbExecutiveClass') as IWbExecutiveClass;
ppDisp := IExec.dd;
IExec := nil;
end;

procedure TWbNodeForm.wbTitleChange(ASender: TObject; const Text: WideString);
begin
WbTitle := Text;
if WbNodeSN>=1 then WbUpdate();
end;

function UrlToProtocol(s:String):String;
var
i:Integer;
begin
//
//
//Given "http://www.google.com/", this returns "http:".
//
//
i := Pos(':',s);
if i=0 then
begin
  Result := 'N/A';
  Exit;
end;
Result := Copy(s,1,i);
end;
function UrlToHost(s:String):String;
var
i1,i2:Integer;
IndexOfLastAt:Integer;
begin
//
//
//Important:
//Note #1. about.com gives wrong information.
//http://delphi.about.com/library/rtl/blrtlPosEx.htm
//  s:='DELPHI PROGRAMMING';
//  i:=PosEx('HI PR', s, 4);
//  //i=1;
//about.com seems to suggest PosEx return value is counted from position of "4".
//But after testing, it turns out:
//The truth is PosEx return value is counted from the first char of string.
//
//Note #2. i2-i1
//"i2-i1" = "the number of characters among i1 and i2" - 1
//For example, if i2=2 and i1=1:
//Then "i2-i1" = "number of characters among i1 and i2"(2) - 1 = 1
//
//
i1 := Pos('://',s);
if i1=0 then
begin
  Result := 'N/A';
  Exit;
end;
i1 := i1 + 3;//skip the found "://" ... length is "3".
i2 := PosEx('/',s,i1);
if i2=0 then
begin
  //DisplayMessage('UrlToHost - no "/" found after "://"','');
  Result := Copy(s,i1,Length(s)-i1+1);//"+1" - include the ending char - see Note #2
end
else
begin
  //DisplayMessage('UrlToHost - "/" found after "://" - i2='+IntToStr(i2),'');
  Result := Copy(s,i1,i2-i1);//exclude the ending char at "i1"(="/") - see Note #2
end;
IndexOfLastAt := LastDelimiter('@', Result);;
if IndexOfLastAt>0 then
  Result := Copy(Result,
                  IndexOfLastAt+1,
                  Length(Result)-(IndexOfLastAt+1) +1
                  //Why "+1"? "i2-i1" = "the number of characters among i1 and i2" - 1
                  );
end;
procedure TWbNodeForm.WbUpdate();
var
d:Variant;
Url,Title,Protocol,Host:String;
s:String;
begin
Url := '';
Title := '';
Protocol := '';
Host := '';
try
  Url := wb.LocationURL;
  //Url := 'NotValidUrl';// ... UrlToProtocol and UrlToHost - it works.
  //Url := 'about:blank';// ... UrlToProtocol and UrlToHost - it works.
  //Url := 'http://www.google.com';// ... UrlToProtocol and UrlToHost - it works.
  //Url := 'http://www.google.com/test';// ... UrlToProtocol and UrlToHost - it works.
  //Url := 'http://username@www.google.com/test';// ... UrlToProtocol and UrlToHost - it works.
  //Url := 'http://blah:blah@blah@www.google.com/';// ... UrlToProtocol and UrlToHost - it works.
  Protocol := UrlToProtocol(Url);
  Host := UrlToHost(Url);
  //Title := wb.OleObject.Document.title;
  Title := WbTitle;
  //Title := wb.GetDocument.title;//... go to gmail(https) and this is really slow.
  //Protocol := wb.GetDocument.location.protocol; //... does not work.
  //Host := wb.GetDocument.location.host; //... does not work.
except
  ;
end;
s:=Encode(URL)+SeperateGuid+
   Encode(Title)+SeperateGuid+
   Encode(Protocol)+SeperateGuid+
   Encode(Host)+SeperateGuid+
   IntToStr(wb.ReadyState);
//DisplayMessage('TWbNodeForm.WbUpdate s="'+s+'"','');

if s=WbNode_UpdatedString then exit;
RemoteCall('Update',
            WbNodeSN,
            s
            );
WbNode_UpdatedString := s;
end;

function TWbNodeForm.RemoteCall(Cmd: String; SN: Integer;
  Param: String): Integer;
var
  sl: TStringList;
  s: String;
begin
  sl := TStringList.Create;
  sl.Add(Cmd);
  sl.Add(IntToStr(SN));
  sl.Add(Param);
  s := sl.Text;
  sl.Free;
  Result := SendString(WbCenterHWND, s);
end;

function TWbNodeForm.Encode(s:String):String;
begin
Result := s;
//encode "-" first - NewLineGuid also has "-" and we don't want to encode it.
Result := StringReplace(Result, '-', HyphenGuid,[rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result, sLineBreak, NewLineGuid,[rfReplaceAll, rfIgnoreCase]);
end;
function TWbNodeForm.Decode(s:String):String;
begin
Result := s;
//"-" decoding is the last decoding ...
//because decoded "-" char should never be further decoded.
Result := StringReplace(Result, NewLineGuid, sLineBreak, [rfReplaceAll, rfIgnoreCase]);
Result := StringReplace(Result, HyphenGuid, '-', [rfReplaceAll, rfIgnoreCase]);
end;

procedure TWbNodeForm.InformAboutNewWindow2();
begin
RemoteCall('NewWindow2', 0, '');
end;

end.
